home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Toolbox classes / Menu < prev    next >
Text File  |  1993-02-06  |  2KB  |  67 lines
  1. \ Menu class.
  2. \ Sept 90  mrh  item# anomalies fixed
  3.  
  4. from  MENUMOD  import{  MENU  APPLEMENU  EDITMENU  }
  5.  
  6. compile: MenuMod
  7. true setInstall: MenuMod
  8.  
  9.  
  10. : DODSK        \ ( item# -- item# )  Executes the desk accessory for an item.
  11.     dup  openDesk: [self]  ;
  12.  
  13.  
  14. : MSELECT    \ ( point -- item# menuID )   Calls menu manager to track a menu selection
  15.     0 swap  call MenuSelect  unpack swap 1- swap  ;
  16.  
  17.  
  18. :class    MBAR        super{ object }
  19.  
  20.    24    ordered-col    IDs
  21.    24    array        MENUS        \ array of menu objects
  22.  
  23. :m DRAW:    call DrawMenuBar  ;m
  24.  
  25. :m CLEAR:    call ClearMenuBar   clear: IDs  ;m
  26.  
  27. :m ADD:        \ ( men1 ... menN N -- )  Adds menu objects to the MenuBar object.
  28.  
  29.     0 DO  i to: menus  i at: menus  id: **  add: ids  LOOP  ;m
  30.  
  31. :m NEW:        \ Inserts menus in Toolbox MenuBar list.
  32.     size: IDs  0
  33.     do   size: IDs  1- i -  at: menus  insert: **   loop
  34.     draw: self  ;m
  35.  
  36. :m INIT:        \ ( men1 ... menN N -- )
  37.     clear: self  add: self  new: self  ;m
  38.  
  39. :m EXEC:    \ ( item# MenuID -- )
  40.     dup 0>
  41.     IF        indexOf: IDs  IF  at: menus  exec: **  THEN
  42.     ELSE    2drop
  43.     THEN  ;m
  44.  
  45. :m CLICK:    where: fevent  mSelect  exec: self  ;m
  46.  
  47. :m KEY:        \ ( c -- )  Handles a possible menu key selection
  48.     0 swap makeint  call MenuKey  unpack  swap 1- swap
  49.     exec: self  ;m
  50.     
  51. :m ENABLE:    \ Enables all menus in the Menu Bar
  52.     size: IDs  0
  53.     DO  i  at: menus  handle: **  word0  call EnableItem  LOOP
  54.     draw: self  ;m
  55.  
  56. :m DISABLE:
  57.     size: IDs  0
  58.     DO  i  at: menus  handle: **  word0  call DisableItem  LOOP
  59.     draw: self  ;m
  60.  
  61. ;class
  62.  
  63.  
  64. mBar    MENUBAR                \ Our default menu bar
  65.  
  66. menubar  put: MBaddr        \ Set as current menu bar
  67.